home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / pointers.swg / 0017_Duplicate File-String.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  1.9 KB  |  84 lines
  1. {
  2.  MG>    Trying to figure out the fastest way
  3.  MG> to find and delete duplicate strings,
  4.  MG> which are actually file names in an
  5.  MG> ASCII file.
  6.  
  7. Using the strings and objects unit, pstringcollections can be used to sort and
  8. test for dupes quite easilly.
  9. }
  10.  
  11. Uses Objects,Strings,Dos;
  12.  
  13. Const
  14.   inFile  : String = '';
  15.   OutFile : String = '';
  16.   DupFile : String = '';
  17.  
  18. Type
  19.   NewPCol = Object(TStringCollection)
  20.               function compare(key1,key2:pointer):integer; virtual;
  21.             end;
  22.  PSColl  = ^NewPCol;
  23.  
  24. Function NewPCol.Compare(key1,key2:pointer):integer;
  25.    Begin
  26.      Compare := StrIComp(key1,key2);
  27.    End;
  28.  
  29. Procedure Doit;
  30.    Var NewLst,
  31.        DupLst : PSColl;
  32.        s      : string;
  33.        ps     : pstring;
  34.        f      : text;
  35.        i      : integer;
  36.    Procedure WriteEm(pst:Pstring); far;
  37.       begin
  38.         writeln(f,pst^);
  39.       end;
  40.    Begin
  41.      New(NewLst,init(5,5));
  42.      New(DupLst,init(5,5));
  43.      DupLst^.Duplicates := true;
  44.      assign(f,InFile);  reset(f);
  45.      While not Eof(f) do
  46.        Begin
  47.          readln(f,s);
  48.          if   s <> ''
  49.          then begin
  50.                 ps := newstr(s);
  51.                 i := NewLst^.Count;
  52.                 NewLst^.insert(ps);
  53.                 if i = NewLst^.Count then DupLst^.insert(ps);
  54.               end;
  55.        End;
  56.      close(f);
  57.      if   NewLst^.count > 0
  58.      then begin
  59.             assign(f,OutFile); rewrite(f);
  60.             NewLst^.forEach(@WriteEm);
  61.             close(f);
  62.           end;
  63.      if   DupLst^.Count > 0
  64.      then begin
  65.             assign(f,DupFile); rewrite(f);
  66.             DupLst^.forEach(@WriteEm);
  67.             close(f);
  68.           end;
  69.      dispose(DupLst,done);
  70.      dispose(NewLst,Done);
  71.   End;
  72.  
  73. Begin
  74.   if paramcount < 2 then halt;
  75.   InFile := paramstr(1);
  76.   OutFile := paramstr(2);
  77.   DupFile := OutFile;
  78.   Dec(DupFile[0],3);
  79.   DupFile := DupFile + 'DUP';
  80.   if DupFile = OutFile then halt;
  81.   Doit;
  82. End.
  83.  
  84.